home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #1 / Ham Radio 2000.iso / ham2000 / misc / dspice0s / relmem.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-11-22  |  2.6 KB  |  92 lines
  1. /* relmem.f -- translated by f2c (version of 3 February 1990  3:36:42).
  2.    You must link the resulting object file with the libraries:
  3.     -lF77 -lI77 -lm -lc   (in that order)
  4. */
  5.  
  6. #include "f2c.h"
  7.  
  8. /* Common Block Declarations */
  9.  
  10. struct {
  11.     doublereal cpyknt;
  12.     integer istack[1], lorg, icore, maxcor, maxuse, memavl, ldval, numblk, 
  13.         loctab, ltab, ifwa, nwoff, ntab, maxmem, memerr, nwd4, nwd8, 
  14.         nwd16;
  15. } memmgr_;
  16.  
  17. #define memmgr_1 memmgr_
  18.  
  19. /* Table of constant values */
  20.  
  21. static integer c__5 = 5;
  22.  
  23. /*<       subroutine relmem(ipntr,ksize) >*/
  24. /* Subroutine */ int relmem_(ipntr, ksize)
  25. integer *ipntr, *ksize;
  26. {
  27.     static integer isize, jsize;
  28.     extern /* Subroutine */ int memadj_(), errmem_();
  29.     extern logical memptr_();
  30.     extern integer nxtevn_();
  31.  
  32.     /* Parameter adjustments */
  33.     --ipntr;
  34.  
  35.     /* Function Body */
  36. /*<       implicit double precision (a-h,o-z) >*/
  37. /*<       dimension ipntr(1) >*/
  38. /* spice version 2g.6  sccsid=memmgr 3/15/83 */
  39. /*<       common /memmgr/ cpyknt,istack(1),lorg,icore,maxcor,maxuse,memavl, >*/
  40. /*<      1   ldval,numblk,loctab,ltab,ifwa,nwoff,ntab,maxmem,memerr,nwd4, >*/
  41. /*<      2   nwd8,nwd16 >*/
  42. /*<       logical memptr >*/
  43.  
  44. /* ***  relmem - release part of block */
  45.  
  46.  
  47. /* ...  check for valid pointer */
  48. /*<       if (memptr(ipntr(1))) go to 10 >*/
  49.     if (memptr_(&ipntr[1])) {
  50.     goto L10;
  51.     }
  52. /*<       memerr=5 >*/
  53.     memmgr_1.memerr = 5;
  54. /*<       call errmem(5,memerr,ipntr(1)) >*/
  55.     errmem_(&c__5, &memmgr_1.memerr, &ipntr[1]);
  56. /*<    10 isize=ksize*istack(ltab+5) >*/
  57. L10:
  58.     isize = *ksize * memmgr_1.istack[memmgr_1.ltab + 4];
  59. /* ...  check for valid size */
  60. /*<       if (isize.ge.0) go to 20 >*/
  61.     if (isize >= 0) {
  62.     goto L20;
  63.     }
  64. /*<       memerr=2 >*/
  65.     memmgr_1.memerr = 2;
  66. /*<       call errmem(5,memerr,ipntr(1)) >*/
  67.     errmem_(&c__5, &memmgr_1.memerr, &ipntr[1]);
  68. /*<    20 jsize=istack(ltab+3) >*/
  69. L20:
  70.     jsize = memmgr_1.istack[memmgr_1.ltab + 2];
  71. /*<       if (isize.le.jsize) go to 30 >*/
  72.     if (isize <= jsize) {
  73.     goto L30;
  74.     }
  75. /*<       memerr=6 >*/
  76.     memmgr_1.memerr = 6;
  77. /*<       call errmem(5,memerr,ipntr(1)) >*/
  78.     errmem_(&c__5, &memmgr_1.memerr, &ipntr[1]);
  79. /*<    30 istack(ltab+3)=istack(ltab+3)-isize >*/
  80. L30:
  81.     memmgr_1.istack[memmgr_1.ltab + 2] -= isize;
  82. /*<       memavl=memavl+(nxtevn(jsize)-nxtevn(istack(ltab+3))) >*/
  83.     memmgr_1.memavl += nxtevn_(&jsize) - nxtevn_(&memmgr_1.istack[
  84.         memmgr_1.ltab + 2]);
  85. /*<       call memadj >*/
  86.     memadj_();
  87. /*<       return >*/
  88.     return 0;
  89. /*<       end >*/
  90. } /* relmem_ */
  91.  
  92.